Attribute VB_Name = "MdlFunciones"
Public Const IMAGE_BITMAP = 0
Public Const LR_COPYRETURNORG = &H4
Public Const CF_BITMAP = 2
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Function rellenarCeros(num)
    t = num
    While Len(t) <= numeroCeros
        t = "0" & t
    Wend
    rellenarCeros = t
End Function
Sub ConfigurarColumnas(ByRef obj)
h = Interlineado
On Error Resume Next
    obj.col11.Left = 0
    obj.col11.Top = 0
    obj.col11.Width = 11350
    obj.col11.Height = h
    
    obj.col21.Left = 3720
    obj.col21.Top = 0
    obj.col21.Width = 6240
    obj.col21.Height = h

    obj.col31.Left = 6240
    obj.col31.Top = 0
    obj.col31.Width = 4530
    obj.col31.Height = h

    obj.col41.Left = 9240
    obj.col41.Top = 0
    obj.col41.Width = 1800
    obj.col41.Height = h
    
    obj.col51.Left = 3000
    obj.col51.Top = 0
    obj.col51.Width = 960
    obj.col51.Height = h
    
    
    obj.col61.Left = 4800
    obj.col61.Top = 0
    obj.col61.Width = 2580
    obj.col61.Height = h
    
    obj.col71.Left = 0
    obj.col71.Top = 0
    obj.col71.CanGrow = False
    obj.col71.Width = 4730
    obj.col71.Height = h
    
    
    obj.col81.Left = 7440
    obj.col81.Top = 0
    obj.col81.Width = 3600
    obj.col81.Height = h
    
    obj.col91.Left = 6840
    obj.col91.Top = 0
    obj.col91.Width = 1080
    obj.col91.Height = h
    
    obj.col101.Left = 7440
    obj.col101.Top = 0
    obj.col101.Width = 2805
    obj.col101.Height = h
    
    obj.col111.Left = 10320
    obj.col111.Top = 0
    obj.col111.Width = 645
    obj.col111.Height = h
'    Exit Sub

    obj.col101.Font.Name = letraReporte
    obj.col101.Font.s ize = tamReporte
    obj.col111.Font.Name = letraReporte
    obj.col111.Font.Size = tamReporte
    obj.col11.Font.Name = letraReporte
    obj.col11.Font.Size = tamReporte
    obj.col21.Font.Name = letraReporte
    obj.col21.Font.Size = tamReporte
    obj.col31.Font.Name = letraReporte
    obj.col31.Font.Size = tamReporte
    obj.col41.Font.Name = letraReporte
    obj.col41.Font.Size = tamReporte
    obj.col51.Font.Name = letraReporte
    obj.col51.Font.Size = tamReporte
    obj.col61.Font.Name = letraReporte
    obj.col61.Font.Size = tamReporte
    obj.col71.Font.Name = letraReporte
    obj.col71.Font.Size = tamReporte
    
    obj.col81.Font.Name = letraReporte
    obj.col81.Font.Size = tamReporte
    
    obj.col91.Font.Size = tamReporte
    obj.col91.Font.Name = letraReporte
    obj.col91.Font.Size = tamReporte


End Sub
Function nombreUsuario()
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from cajero where identifica='" & UsuarioEntro & "'")
    If t.EOF Then
        nombreUsuario = ""
    Else
        nombreUsuario = t(1)
    End If
    
End Function
Sub ActGestor()
    FrmGestor.mostrarDetalle
End Sub
Function EsPerfilRes(ce)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from PerfilResultados where cod_examen=" & ce)
    If Not t.EOF Then
        EsPerfilRes = True
    Else
        EsPerfilRes = False
    End If

End Function
Sub AgregarValorVacio()
            Dim t As DAO.Recordset
        Dim x As DAO.Recordset
    
    Set t = Base.OpenRecordset("select *from examenes ")
    While Not t.EOF
        On Error Resume Next
        Set x = Base.OpenRecordset("select *from valores where cod_examen=" & t(0) & "")
        If x.EOF Then
            Base.Execute "insert into valores (cod_examen,valor) values ( " & t(0) & ",' ')"
        End If
        t.MoveNext
    Wend
End Sub
Sub Auditar(a, m, r)
On Error Resume Next
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("auditoria")
    t.AddNew
        t(0) = UsuarioEntro
        t(1) = Date
        t(2) = Time
        t(3) = a
        t(4) = m
        t(5) = r
    t.Update
End Sub
Sub Niveles(Usuario As DAO.Recordset)
    
    With frmMenuPrincipal
        .MnuPedidos.Enabled = Usuario(6)
        .toolBarMenu.Buttons(1).Enabled = Usuario(6)
        .Presu.Enabled = Usuario(7)
        .toolBarMenu.Buttons(2).Enabled = Usuario(7)
        .OP.Enabled = Usuario(8)
        .OT.Enabled = Usuario(9)
        .toolBarMenu.Buttons(3).Enabled = Usuario(9)
        .MnuGestor.Enabled = Usuario(10)
        .toolBarMenu.Buttons(4).Enabled = Usuario("ordpac")
        .valery.Enabled = Usuario(11)
        .Perso = Usuario(12)
        .RepEsta = Usuario(13)
        .toolBarMenu.Buttons(5).Enabled = Usuario(10)
        .Exames = Usuario(14)
        .pdr = Usuario(15)
        .RIPC = Usuario(16)
        .Lista = Usuario(17)
        .Abona = Usuario(18)
        .onstancias = Usuario(19)
        .BIOPIO.Enabled = Usuario(20)
        .EAO.Enabled = Usuario(21)
        .MnuRelacion = Usuario(22)
        .MnuPerfiles = Usuario(23)
        .mIdem = Usuario(24)
        .MnuPrecios = Usuario(25)
        .IIVA = Usuario(26)
        .MnuSeguridad = Usuario(27)
        .Auditor = Usuario(28)
        .bd = Usuario(29)
        .RR.Enabled = Usuario(30)
        .Inicio.Enabled = Usuario(31)
        .asp.Enabled = Usuario(32)
        .PG.Enabled = Usuario(33)
        .Valorame.Enabled = Usuario(34)
        .CD.Enabled = Usuario(35)
        .toolBarMenu.Buttons(6).Enabled = Usuario(35)
        .CSI.Enabled = Usuario(36)
        .Abona = Usuario(37)
        .Alma = Usuario(38)

    End With
    Exit Sub
    NivelEntro = nivel
    With frmMenuPrincipal
        .MnuArch.Enabled = True
        .MnuRes.Enabled = True
        .Rep.Enabled = True
        .Gerenc.Enabled = True
        .toolBarMenu.Buttons(1).Enabled = True
        .toolBarMenu.Buttons(2).Enabled = True
        .toolBarMenu.Buttons(3).Enabled = True
        .toolBarMenu.Buttons(4).Enabled = True
        .toolBarMenu.Buttons(5).Enabled = True
        .toolBarMenu.Buttons(6).Enabled = True

    If nivel = 1 Then
        .MnuArch.Enabled = True
        .MnuRes.Enabled = False
        .Rep.Enabled = False
        .Gerenc.Enabled = False
        .toolBarMenu.Buttons(1).Enabled = True
        .toolBarMenu.Buttons(2).Enabled = True
        .toolBarMenu.Buttons(3).Enabled = False
        .toolBarMenu.Buttons(4).Enabled = False
        .toolBarMenu.Buttons(5).Enabled = False
        .toolBarMenu.Buttons(6).Enabled = False
    End If
    If nivel = 2 Then
        .MnuArch.Enabled = True
        .MnuRes.Enabled = True
        .Rep.Enabled = False
        .Gerenc.Enabled = False
        .toolBarMenu.Buttons(1).Enabled = True
        .toolBarMenu.Buttons(2).Enabled = True
        .toolBarMenu.Buttons(3).Enabled = True
        .toolBarMenu.Buttons(4).Enabled = True
        .toolBarMenu.Buttons(5).Enabled = False
        .toolBarMenu.Buttons(6).Enabled = False
    
    End If
    If nivel = 3 Then
        .MnuArch.Enabled = True
        .MnuRes.Enabled = True
        .Rep.Enabled = True
        .Gerenc.Enabled = False
        .toolBarMenu.Buttons(1).Enabled = True
        .toolBarMenu.Buttons(2).Enabled = True
        .toolBarMenu.Buttons(3).Enabled = True
        .toolBarMenu.Buttons(4).Enabled = True
        .toolBarMenu.Buttons(5).Enabled = True
        .toolBarMenu.Buttons(6).Enabled = True
    End If
    If nivel = 4 Then
        .MnuArch.Enabled = True
        .MnuRes.Enabled = True
        .Rep.Enabled = True
        .Gerenc.Enabled = True
    End If
    
    
    End With
    
    
End Sub
Sub BuscarValor(D, res, com)
    Dim t As DAO.Recordset
    If Mid(D, 1, 1) = "." Then
        D = "0" + D
    End If
    a = COMAPORPUNTO(Val(D))
    sql = "select *from [Alergenos Valores] where (desde<=" & a & ") AND (hasta >= " & a & ")"
    Set t = Base.OpenRecordset(sql)
    If Not t.EOF Then
        res = t("res")
        com = t("Comentario")
    End If
End Sub

Function FormatoFecha(f)
    FormatoFecha = Format(f, "mm/dd/yyyy")
End Function
Function AutoNumero(Campo, tabla) As Long
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select max(" & Campo & ") from [" & tabla & "]")
    If Not IsNumeric(t(0)) Then
        AutoNumero = 1
    Else
        AutoNumero = t(0) + 1
    End If
End Function


Function CualGrupo(desc)
Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select idgrupo from grupo where descripcion='" & desc & "'")
    If Not t.EOF Then
        CualGrupo = t(0)
    Else
        CualGrupo = 0
    End If
End Function
Function CualDesGrupo(Id)
Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select descripcion from grupo where idgrupo =" & Val(Id))
    If Not t.EOF Then
        CualDesGrupo = t(0)
    Else
        CualDesGrupo = 0
    End If
End Function
Function MostrarCampo(tabla As String, Campo As String, filtro As String)
    Dim rs As DAO.Recordset
    Set rs = Base.OpenRecordset("select *from [" & tabla & "] where " & filtro)
    If rs.EOF Then
        MostrarCampo = ""
    Else
        MostrarCampo = rs(Campo)
    End If
End Function

Function CampoExamen(cod, Campo)
Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from examenes where cod_examen=" & Val(cod))
    If Not t.EOF Then
        CampoExamen = t(Campo)
    Else
        CampoExamen = ""
    End If
End Function
Function CampoPaciente(cedula, Campo)
Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from paciente where cedula='" & cedula & "'")
    If Not t.EOF Then
        CampoPaciente = t(Campo)
    Else
        CampoPaciente = ""
    End If
End Function

Function porcPendientes(Pedido)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select count(*) from detalles,examenes,grupo where detalles.cod_Examen = examenes.cod_examen and grupo.idGrupo=examenes.idgrupo and cod_pedido=" & Pedido & " AND grupo.descripcion<>'INSUMOS' AND GRUPO.DESCRIPCION<>'SERVICIOS'")
    totalexa = t(0)
    Set t = Base.OpenRecordset("select count(*) from detalles,examenes,grupo where  detalles.cod_Examen = examenes.cod_examen and grupo.idGrupo=examenes.idgrupo and cod_pedido=" & Pedido & " and (st='i' or st='g') AND grupo.descripcion<>'INSUMOS' AND GRUPO.DESCRIPCION<>'SERVICIOS'")
    totalpen = t(0)
    If totalexa > 0 Then
        porcPendientes = Int((totalpen * 100) / totalexa)
    Else
        If totalexa = 0 And totalpen = 0 Then
            porcPendientes = 200
        Else
            porcPendientes = 0
        End If
    End If
End Function
Function titulo(t)
    titulo = Version + "         " + t + "          " + NombreLab + "                        " + nombreUsuario
End Function
Function titulo2(t)
    titulo2 = "       " + t
End Function
Function Generar_Paciente()
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select max(pacientenro) from pedido  where fecha=#" & Format(Date, "mm/dd/yyyy") & "#")
    If Not IsNumeric(t(0)) Then
        Generar_Paciente = 1
    Else
        Generar_Paciente = t(0) + 1
    End If
End Function
Function nombreExamen(cod)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select Descripcion from Alergenos where cod_alergeno=" & cod)
    While Not t.EOF
        a = t(0)
        t.MoveNext
    Wend
    nombreExamen = a
End Function
Function ObtenerNombreExa(cod)
    Dim t As DAO.Recordset
    If IsNull(cod) Then Exit Function
    Set t = Base.OpenRecordset("select Descripcion from examenes where cod_examen=" & cod)
    While Not t.EOF
        a = t(0)
        t.MoveNext
    Wend
    ObtenerNombreExa = a
End Function

Function ObtenerCodigo(nom)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from alergenos where descripcion='" & nom & "'")
    If Not t.EOF Then
        ObtenerCodigo = t(0)
    Else
        ObtenerCodigo = 0
    End If
End Function
Function ObtenerCodigoexa(nom)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from EXAMENES where descripcion='" & nom & "'")
    If Not t.EOF Then
        ObtenerCodigoexa = t(0)
    Else
        ObtenerCodigoexa = 0
    End If
End Function

Sub LlenarCombo(combo As Object, sql)
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset(sql)
'    a = t(0)
    combo.Clear
    
    While Not t.EOF
        If Not IsNull(t(0)) Then combo.AddItem (t(0))
        t.MoveNext
    Wend
    'Combo.Text = a
End Sub
Public Function esBioanalista(identifica As String) As Boolean
    Dim conexion As New ADODB.Connection
    Dim tBioanalista As New ADODB.Recordset
    Database.conect conexion
    tBioanalista.Open "SELECT cedula from bioanalistas WHERE identifica='" & identifica & "'", conexion
    esBioanalista = Not tBioanalista.EOF
End Function
Public Function cedBioanalista(identifica As String) As String
    Dim conexion As New ADODB.Connection
    Dim tBioanalista As New ADODB.Recordset
    Database.conect conexion
    tBioanalista.Open "SELECT cedula from bioanalistas WHERE identifica='" & identifica & "'", conexion
    If tBioanalista.EOF Then
        cedBioanalista = "0"
        Exit Function
    End If
    cedBioanalista = tBioanalista("cedula").value
End Function
Sub LlenarCombo2(combo As Object, sql)
On Error Resume Next
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset(sql)
    a = t(0).value
    combo.Clear
    
    While Not t.EOF
            combo.AddItem (t(0).value)
        t.MoveNext
    Wend
    combo.Text = a
End Sub

Function COMAPORPUNTO(v)
r = ""
    For i = 1 To Len(v)
        l = Mid(v, i, 1)
        If l = "," Then
            r = r + "."
        Else
            r = r + l
        End If
    Next
    COMAPORPUNTO = r
End Function
Public Function buscarLista(ByVal list As ListBox, ByVal dato As String) As Boolean
    Dim Total As Integer
    Dim i As Integer
    Dim existe As Boolean
    existe = False
    Total = list.ListCount - 1
    For i = 0 To Total
        existe = list.list(i) = dato
        If existe Then Exit For
    Next i
    buscarLista = existe
End Function
Sub enter(ka)
    If ka = 13 Then SendKeys ("{TAB}")
End Sub
Function aplicaIva(nombreExamen) As Boolean
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from examenes where Descripcion='" & nombreExamen & "'")
    a = False
    If Not t.EOF Then
        a = t("iva").value
    End If
    aplicaIva = a
End Function

Public Function Code_Generate(tabla As DAO.Recordset) As String
Dim Codigo As Long
On Error GoTo 2:
    tabla.MoveLast
    Codigo = Val(tabla(0))
    Codigo = Codigo + 1
    Code_Generate = Codigo
    Exit Function
2:
    Code_Generate = "1"

End Function

Sub Cambiar(Tecla As Integer)
    If Tecla = 13 Then
    On Error Resume Next
        Tecla = 0
        SendKeys "{TAB}"
        'SendKeys "{ESC}"
    End If
End Sub

Public Function LoadParameters(crObject As CrystalReport) As CrystalReport
    crObject.setParam "nombreLab", MainModule.NombreLab
    crObject.setParam "entro", MainModule.UsuarioEntro
    crObject.setParam "direccionlab", MainModule.DireccionLab
    crObject.setParam "telefonolab", MainModule.TelefonoLab
    crObject.setParam "telefono", MainModule.TelefonoLab
    crObject.setParam "nombrelab2", MainModule.NombreLab2
    crObject.setParam "rif", MainModule.Rif
    crObject.setParam "otros", MainModule.Otros
    crObject.setParam "textrep", MainModule.textoRep
    crObject.setParam "Licenciado", FrmGestor.cmbBioanalista.Text
    crObject.setParam "cajero", frmReporteGeneral.Combo1.Text
    crObject.setParam "iden", frmReporteGeneral.Combo5.Text
    crObject.setParam "clasificacion", frmReporteGeneral.Combo7.Text
    crObject.setParam "operacion", frmReporteGeneral.Combo3.Text
    crObject.setParam "desde", Format(frmReporteGeneral.DTPicker1.value, "dd/mm/yyyy")
    crObject.setParam "hasta", Format(frmReporteGeneral.DTPicker2.value, "dd/mm/yyyy")
    
    crObject.setParam "forma", frmReporteGeneral.Combo4.Text
    crObject.setParam "precio1", (FrmLista.List2.list(0))
    crObject.setParam "precio2", (FrmLista.List2.list(1))
    crObject.setParam "precio3", (FrmLista.List2.list(2))
    crObject.setParam "precio4", (FrmLista.List2.list(3))
    crObject.setParam "precio5", (FrmLista.List2.list(4))
    crObject.setParam "ciPac", FrmGestor.ciPac
    crObject.setParam "NombrePac", FrmGestor.NombrePac
    Set LoadParameters = crObject
End Function

Function BuscarResultadoQuimica(ByVal codPedido As Integer, ByVal DES As String, ByVal Presultado As String) As String
    Dim conexion As New ADODB.Connection
    Database.conect conexion
    Dim tQuery As New ADODB.Recordset
    tQuery.Open "SELECT resultado FROM [" & Presultado & "] WHERE  cod_pedido=" & codPedido & " AND descripcion='" & DES & "'", conexion
    BuscarResultadoQuimica = "-"
    If Not tQuery.EOF Then BuscarResultadoQuimica = tQuery("resultado")
    Database.closeDb conexion
End Function
Function BuscarObservacionQuimica(ByVal codPedido As Integer, ByVal DES As String, ByVal Presultado As String) As String
    Dim conexion As New ADODB.Connection
    Database.conect conexion
    Dim tQuery As New ADODB.Recordset
    tQuery.Open "SELECT observacion FROM [" & Presultado & "] WHERE cod_pedido=" & codPedido & " AND descripcion='" & DES & "'", conexion
    BuscarObservacionQuimica = "-"
    If Not tQuery.EOF Then BuscarObservacionQuimica = tQuery("observacion")
    Database.closeDb conexion
End Function
Function BuscarCodDetalleQuimica(ByVal cod_pedido As Integer, ByVal DES As String, ByVal Presultado As String) As String
    Dim t As DAO.Recordset
    Dim stringSql As String
    stringSql = "select *from [" & Presultado & "] where cod_pedido=" & cod_pedido & " and descripcion='" & DES & "'"

    Set t = Base.OpenRecordset(stringSql)
    If Not t.EOF Then
        BuscarCodDetalleQuimica = t("cod_detalle")
    Else
        BuscarCodDetalleQuimica = "-"
    End If
End Function

Function BuscarObsQuimica(ByVal cod_pedido As Integer, ByVal DES As String, ByVal Presultado As String) As String
'On Error GoTo 2
    Dim t As DAO.Recordset
    Set t = Base.OpenRecordset("select *from [" & Presultado & "] where cod_pedido=" & cod_pedido & " and descripcion='" & DES & "'")
    If Not t.EOF Then
        BuscarObsQuimica = t("observacion")
    Else
2:
        BuscarObsQuimica = "-"
    End If

End Function

